home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj0687.arc / DRAWCHAR.PAS < prev    next >
Pascal/Delphi Source File  |  1987-04-23  |  7KB  |  237 lines
  1.  
  2. program TestWrite;
  3.  
  4. const
  5.     ScreenHeight = 199;         {rows of screen: 0 ... 199}
  6.  
  7. type
  8.     Nodepointer = ^Node;
  9.     Node = record
  10.         across : integer;       {position in row}
  11.         ascii  : byte;          {character code}
  12.         xScale,
  13.         yScale :  real;         {scaling factors}
  14.         next   : Nodepointer;   {forward link}
  15.         end;
  16.  
  17.  
  18. Var
  19.     Lines, LastEntry: array[0..screenheight] of Nodepointer;
  20.                       {point to first and last entry in row}
  21.     Temp       : Nodepointer;
  22.     xStretch,
  23.     yStretch   : real;
  24.     mode       : byte;          {inserting = 7, deleting = 0}
  25.     ch         : char;
  26.     x, y       : integer;
  27.  
  28.  
  29. { Definitions for the font tables }
  30. Type
  31.     CharString = string[40];
  32.     Font       = array[33..126] of CharString;
  33.  
  34. Var
  35.     FontArray  : Font;          {Array of strings describing fonts}
  36.  
  37.  
  38. procedure LoadFonts;
  39. const
  40.   FontsFilename = 'FONTS';
  41. var
  42.   Fonts: file of Font;
  43. begin
  44.   (****  These are the correct LoadFonts statements:
  45.   assign(Fonts, FontsFilename);
  46.   read(Fonts,FontArray);
  47.   close(Fonts);
  48.   ****)
  49.   {The following is just the letter "A" for demonstration driver.}
  50.   FontArray[65] := #10 + #64 + #64 + #138 + #37 + #101;
  51. end; {LoadFonts}
  52.  
  53.  
  54.  
  55. procedure DrawString(Z: Nodepointer; row: integer; mode: byte);
  56. var I, P, Q: integer;
  57.     Coordinates: CharString;
  58.     x,y: integer;
  59. begin
  60.     I:= 1;
  61.     with Z^ do  begin
  62.       Coordinates:= FontArray[ascii];
  63.       x:= across; y:= row;
  64.       while I < length(Coordinates) do begin
  65.         P:= ord(Coordinates[I]); Q:= ord(Coordinates[I+1]);
  66.         draw(round((P div 16)* xscale + x),round((P mod 16)*yscale+y),
  67.              round((Q div 16)* xscale + x),round((Q mod 16)*yscale+y),
  68.              mode);
  69.         I:= I + 2
  70.         end;  {while}
  71.       end;  {with}
  72. end; {DrawString}
  73.  
  74.  
  75.  
  76. procedure MakeNode(var P: Nodepointer; x:integer; asc :byte;
  77.                           scx, scy: real);
  78. begin
  79.   new(P);
  80.   with P^ do begin
  81.     across:= x; ascii:= asc; xScale:= scx; yScale:= scy;
  82.     next:= nil;
  83.     end;
  84. end;
  85.  
  86.  
  87.  
  88. { Edit: head is Lines[y], last is LastEntry[y]; }
  89. {       P points to the node to be inserted/deleted. }
  90.  
  91. procedure Edit(var head, last, P: Nodepointer;
  92.                      row: integer; mode: byte);
  93. var place, follower: Nodepointer;
  94. begin
  95.   follower:= head;
  96.   if (head = nil) and (mode = 7)
  97.     then begin  {list is empty, so insert}
  98.       head:= P;
  99.       last:= P;
  100.       DrawString(P, row, mode);
  101.       end
  102.   else if (head = nil) and (mode = 0) then begin end
  103.     else if (P^.across > last^.across) and (mode = 7)
  104.       then begin              {character further to right than others}
  105.         last^.next:= P;
  106.         last:= P;
  107.         DrawString(P, row, mode);
  108.         end
  109.     else if (P^.across > last^.across) and (mode = 0)
  110.       then begin end
  111.       else  {must insert or delete a node in the interior of row}
  112.         begin
  113.           place:= head;
  114.           if (P^.across = place^.across) {correct position}
  115.                        and (mode = 0) {deleting}
  116.             then
  117.               begin
  118.                 while (place^.ascii <> P^.ascii)
  119.                        and (place^.next <>  nil)
  120.                   do begin
  121.                     follower:= place;
  122.                     place:= place^.next;
  123.                     end;
  124.                 if (place^.ascii = P^.ascii)
  125.                   then begin
  126.                     if follower <> head
  127.                       then follower^.next:= place^.next
  128.                       else head:= place^.next;
  129.                     if last = place then last:=  follower;
  130.                     DrawString(place, row, mode);
  131.                     dispose(place);
  132.                     dispose(P);
  133.                     end
  134.                 end  {if deleting}
  135.             else if (P^.across <= place^.across) and (mode = 7)
  136.               then begin
  137.                 head:= P;
  138.                 P^.next:= place;
  139.                 DrawString(P, row, mode);
  140.                 end  {if inserting}
  141.               else   {not in first position}
  142.                 begin
  143.                   while(place <> last)
  144.                             and (P^.across > place^.across) do
  145.                     begin
  146.                       follower:= place;
  147.                       place:= place^.next
  148.                     end; {while}
  149.                   if (P^.across = place^.across)  {correct pos.}
  150.                             and (mode = 0)     {deleting}
  151.                     then
  152.                       begin
  153.                         while (place^.ascii <> P^.ascii)
  154.                             and (place^.next <> nil)
  155.                           do begin
  156.                             follower:= place;
  157.                             place:= place^.next;
  158.                             end;
  159.                         if (place^.ascii = P^.ascii) then begin
  160.                           follower^.next:= place^.next;
  161.                           if last = place then last:= follower;
  162.                           DrawString(place, row, mode);
  163.                           dispose(place);
  164.                           dispose(P);
  165.                           end;
  166.                       end  {if deleting}
  167.                     else  {inserting}
  168.                       begin
  169.                         follower^.next:= P;
  170.                         P^.next:= place;
  171.                         DrawString(P, row, mode);
  172.                       end {inserting}
  173.                 end  {not in first position}
  174.           end  {interior node}
  175. end;  {Edit}
  176.  
  177.  
  178. (********************************************************************)
  179.  
  180.  
  181. procedure WriteOut;
  182. var
  183.     place : nodepointer;
  184.     row   : integer;
  185. begin
  186.   for row := 0 to screenheight do begin
  187.     place := Lines[row];        {point to head of row}
  188.     if place <> nil then        {something in row}
  189.       repeat
  190.         DrawString(place, row, 7);
  191.         place:= place^.next;
  192.       until place = nil
  193.     end; {for}
  194. end; {WriteOut}
  195.  
  196.  
  197.  
  198. procedure InitializeList;
  199. var
  200.     I  : integer;
  201. begin
  202.   For I:= 0 to screenheight do
  203.     begin
  204.       New(Lines[I]);
  205.       Lines[I] := nil;
  206.       New(LastEntry[I]);
  207.       LastEntry[I] := nil;
  208.     end;
  209. end; {InitializeList}
  210.  
  211.  
  212.  
  213. begin
  214.  
  215.   LoadFonts;
  216.   InitializeList;
  217.   HiRes;
  218.  
  219.   repeat
  220.     write('Enter x coordinate: ');        readln(x);
  221.     write('Enter y coordinate: ');        readln(y);
  222.     write('Enter horizontal stretch: ');  readln(xstretch);
  223.     write('Enter vertical stretch: ');    readln(ystretch);
  224.     write('Add or delete (a/d) ? ');      readln(ch);
  225.     if ch = 'd' then mode:= 0 else mode:= 7;
  226.     MakeNode(Temp, x, 65, xstretch, ystretch);
  227.     Edit(Lines[y], LastEntry[y], Temp, y, mode);
  228.     write('Draw again (y/n)?');           readln(ch);
  229.   until ch = 'n';
  230.  
  231.   HiRes;
  232.   WriteOut;
  233.   readln;
  234.   textmode(C80);
  235.  
  236. end.
  237.